perm filename INTERP.F4[3,ALS] blob sn#041473 filedate 1973-05-13 generic text, type T, neo UTF8
      implicit double precision (a-h,o-z)
      dimension x(30),f(30)
1     type 400
      accept 401,npts
      if (npts) 999,999,30
30    type 402
      do 50 i=1,npts
50    accept 403,x(i),f(i)
      type 404
      accept 401,mode
      type 406
      accept 407,xwant
      do 100 i1=1,npts-1
      xi=x(i1)
      dif=xwant-xi
      fi=f(i1)
      save1=f(i1+1)
      do 200 j1=i1+1,npts
200   f(j1)=fi+dif*(f(j1)-fi)/(x(j1)-xi)
      if (mode) 220,100,100
220   do 150 k=i1+1,npts
150   type 500,f(k)
      type 501
100   continue
      type 502,f(npts)
      type 501
      goto 1
999   stop
400   format(' number of points='$)
401   format(i)
402   format(' input x,f(x):'/)
403   format(2d)
404   format(' mode='$)
406   format(' want f(x) at x='$)
407   format(d)
500   format(1x,d)
501   format('-')
502   format(' f(x)=',1pd20.10)
      end